home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.003 / stk-3 / stk / 3.1 / STk / Canvitem.stklos < prev    next >
Encoding:
Text File  |  1996-07-29  |  14.8 KB  |  459 lines
  1. ;;;;
  2. ;;;; C a n v i t e m . s t k       --  Canvas Items classes definition
  3. ;;;;
  4. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  15. ;;;;    Creation date: 24-Aug-1993 11:24
  16. ;;;; Last file update: 17-Jan-1996 23:53
  17.  
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ;;;;
  21. ;;;; <Tk-canvas-item>
  22. ;;;;
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24.  
  25. (define-class <Tk-canvas-item> (<Tk-object>)
  26.   ((Cid :getter  Cid))
  27.   :metaclass <Tk-item-metaclass>)
  28.  
  29. (define-method initialize ((self <Tk-canvas-item>) initargs)
  30.   (let* ((parent  (get-keyword :parent initargs #f))
  31.      (coords  (get-keyword :coords initargs '())))
  32.  
  33.     ;; Verify that parent exists and that it is a canvas 
  34.     (unless parent
  35.        (error "**** You must specify the canvas which contain this object"))
  36.     (unless (is-a? parent <Canvas>)
  37.        (error "**** Specified canvas ~A is not valid" parent))
  38.  
  39.     (let ((parent-Id (slot-ref parent 'Id)))
  40.       (slot-set! self 'parent parent)
  41.       (slot-set! self 'Id  parent-Id)
  42.       (slot-set! self 'Eid parent-Id)
  43.       ;; Initialize Cid last because composite item need it
  44.       (let ((Cid (initialize-item self parent-Id coords initargs)))
  45.     (slot-set! self 'Cid Cid)
  46.     (hash-table-put! (slot-ref parent 'items) Cid self)))
  47.     (next-method)))
  48.  
  49. (define-method initialize-item ((self <Tk-canvas-item>) canv-Id coords args)
  50.   (error "initialize-item: no method for ~S subclass" self))
  51.  
  52. (define-method Tk-write-object ((self <Tk-Canvas-item>) port)
  53.   (write (slot-ref self 'Cid) port))
  54.  
  55. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  56. ;;;;
  57. ;;;; <Tk-canvas-figure> class definition
  58. ;;;;
  59. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60.  
  61. (define-class <Tk-canvas-figure> (<Tk-canvas-item>)
  62.   ((tags   :accessor tags   
  63.        :init-keyword :tags 
  64.        :allocation   :tk-virtual)
  65.    (coords :accessor     coords 
  66.        :init-keyword :coords
  67.        :allocation   :virtual 
  68.        :slot-ref     (lambda (o) 
  69.                ((slot-ref o 'Id) 'coords (slot-ref o 'Cid)))
  70.        :slot-set!     (lambda (o v)
  71.                (apply (slot-ref o 'Id) 'coords (slot-ref o 'Cid) v)))))
  72.  
  73. (define-method initialize-item ((self <Tk-canvas-figure>) canv-Id coords args)
  74.   (apply canv-Id 'create (canvas-item-initializer self)
  75.          (append coords (get-keyword :tk-options args '()))))
  76.  
  77. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78. ;;;;
  79. ;;;; <Tk-composite-item> class
  80. ;;;;
  81. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82.  
  83. (define-class <Tk-composite-item> (<Tk-canvas-item>)
  84.   ()
  85.   :metaclass <Tk-composite-item-metaclass>)
  86.  
  87. (define-method add-to-group ((self <Tk-composite-item>) . items)
  88.   (let ((tag (Cid self)))
  89.     (for-each (lambda (i) (add-tag i tag)) items)))
  90.  
  91. (define-method delete-from-group ((self <Tk-composite-item>) item)
  92.   (delete-tag item (Cid self)))
  93.  
  94. (define-method items-of-group ((self <Tk-composite-item>))
  95.   (find-items (slot-ref self 'parent) 'withtag (Cid self)))
  96.  
  97.  
  98. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  99. ;;;;
  100. ;;;; <Canvas-group> class definition
  101. ;;;;
  102. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  103.  
  104. (define-class <Canvas-group> (<Tk-composite-item>)
  105.   ()
  106. )
  107.  
  108. (define-method initialize-item ((self <Canvas-group>) parent-Id coords initargs)
  109.   ;; Just return the tag which will be shared among items
  110.   (gensym "group"))
  111.  
  112. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  113. ;;;;
  114. ;;;; Utilities
  115. ;;;;
  116. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  117.  
  118.  
  119. ;; tag-value delivers the integer Id of an object
  120. (define-method tag-value ((object <Tk-canvas-item>))
  121.   (slot-ref object 'Cid))
  122.  
  123. ;;;
  124. ;;; Utility: Cid->instance
  125. ;;;
  126. (define (Cid->instance canvas id)
  127.   (hash-table-get (slot-ref canvas 'items) id #f))
  128.  
  129.  
  130. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  131. ;;;;
  132. ;;;; <Tk-canvas-item> methods
  133. ;;;;
  134. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  135.  
  136. ;;;
  137. ;;; Add-tag
  138. ;;;
  139. (define-method add-tag ((self <Tk-canvas-item>) tag)
  140.   ((slot-ref self 'Id) 'addtag tag 'withtag (slot-ref self 'Cid)))
  141.  
  142. ;;;
  143. ;;; Bounding-box
  144. ;;;
  145. (define-method bounding-box ((self <Tk-canvas-item>))
  146.   ((slot-ref self 'Id) 'bbox (slot-ref self 'Cid)))
  147.  
  148. ;;;
  149. ;;; Bind
  150. ;;;
  151. (define-method bind ((self <Tk-canvas-item>) . args)
  152.   (apply (slot-ref self 'Id) 'bind (slot-ref self 'Cid) args))
  153.  
  154.  
  155. ;;;
  156. ;;; Delete-chars
  157. ;;;
  158. (define-method delete-chars ((self <Tk-Canvas-item>) first . last)
  159.   (apply (slot-ref self 'Id) 'dchars (slot-ref self 'Cid) first last))
  160.  
  161.  
  162. ;;;
  163. ;;; Delete/Destroy
  164. ;;;
  165. (define-method destroy ((self <Tk-canvas-item>))
  166.   (let ((parent   (slot-ref self 'parent))
  167.     (cid-item (slot-ref self 'Cid)))
  168.  
  169.     ;; First delete item from canvas
  170.     ((slot-ref parent 'Id) 'delete cid-item)
  171.     ;; Now delete its reference in the hash table
  172.     (hash-table-remove! (slot-ref parent 'items) cid-item)
  173.     ;; Change class of the item to <Destroyed-object>
  174.     (change-class self <Destroyed-object>)))
  175.  
  176. (define-method destroy ((self <Tk-composite-item>))
  177.   (let* ((parent (slot-ref self 'parent))
  178.      (all    (find-items parent 'with (Cid self))))
  179.  
  180.     ;; Destroy each components
  181.     (for-each destroy all)
  182.     ;; Delete reference of the group in hash table
  183.     (hash-table-remove! (slot-ref parent 'items) (Cid self)))
  184.     ;; Change class of the group to <Destroyed-object>
  185.     (change-class self <Destroyed-object>))
  186.  
  187. (define-method delete ((self <Tk-canvas-item>))
  188.   ;; For compatibility with older versions
  189.   (destroy self))
  190.  
  191. ;;;
  192. ;;; Delete-tag
  193. ;;;
  194. (define-method delete-tag ((self <Tk-canvas-item>) tag-to-delete)
  195.   ((slot-ref self 'Id) 'dtag  (slot-ref self 'Cid) tag-to-delete))
  196.  
  197. ;;;;;;;;;; find is useless for Tk-canvas-item
  198.  
  199. ;;;
  200. ;;; focus
  201. ;;;
  202. (define-method focus ((self <Tk-canvas-item>))
  203.   ((slot-ref self 'Id) 'focus  (slot-ref self 'Cid)))
  204.  
  205. ;;;
  206. ;;; get-tags
  207. ;;;
  208. (define-method get-tags ((self <Tk-canvas-item>))
  209.   ((slot-ref self 'Id) 'gettags (slot-ref self 'Cid)))
  210.  
  211. ;;;
  212. ;;; Icursor
  213. ;;;
  214. (define-method icursor ((self <Tk-Canvas-item>) index)
  215.   ((slot-ref self 'Id) 'icursor (slot-ref self 'Cid) index))
  216.  
  217. ;;;
  218. ;;; Index
  219. ;;;
  220. (define-method text-index ((self <Tk-Canvas-item>) index)
  221.   ((slot-ref self 'Id) 'index (slot-ref self 'Cid) index))
  222.  
  223. ;;;
  224. ;;; Insert
  225. ;;;
  226. (define-method text-insert ((self <Tk-Canvas-item>) before string)
  227.   ((slot-ref self 'Id) 'insert  (slot-ref self 'Cid) before string))
  228.  
  229. ;;;
  230. ;;; Lower
  231. ;;;
  232. (define-method lower ((self <Tk-canvas-item>) . below)
  233.   (apply (slot-ref self 'Id) 'lower (slot-ref self 'Cid) (map tag-value below)))
  234.  
  235. ;;;
  236. ;;; Move
  237. ;;;
  238. (define-method move ((self <Tk-canvas-item>) x y)
  239.   ((slot-ref self 'Id) 'move (slot-ref self 'Cid) x y))
  240.  
  241. ;;;;;;;;;; postscript has no sense for Tk-canvas-item
  242.  
  243. ;;;
  244. ;;; Raise
  245. ;;;
  246. (define-method raise ((self <Tk-canvas-item>) . above)
  247.   (apply (slot-ref self 'Id) 'raise (slot-ref self 'Cid) (map tag-value above)))
  248.  
  249. ;;;
  250. ;;; Rescale
  251. ;;;
  252. (define-method rescale ((self <Tk-canvas-item>) x y xs ys)
  253.   ((slot-ref self 'Id) 'scale (slot-ref self 'Cid) x y xs ys))
  254.  
  255. ;;;
  256. ;;; Text-selection  (not implemented. What is the prototype?)
  257. ;;;
  258.  
  259. ;;;;;;;; item-type can (approximatively) be obtained by (class-name(class-of xxx))
  260.  
  261. ;;;
  262. ;;; xview
  263. ;;;
  264. (define-method xview ((self <Tk-canvas-item>) x)
  265.   ((slot-ref self 'Id) 'xview x))
  266.  
  267.  
  268. ;;;
  269. ;;; yview
  270. ;;;
  271. (define-method yview ((self <Tk-canvas-item>) x)
  272.   ((slot-ref self 'Id) 'yview x))
  273.  
  274.  
  275. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  276. ;;;;
  277. ;;;; <Arc> class definition
  278. ;;;;
  279. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  280. (define-class <Arc> (<Tk-canvas-figure>)
  281.   ((extent  :accessor extent    :init-keyword :extent  :allocation :tk-virtual)
  282.    (fill    :accessor fill     :init-keyword :fill    :allocation :tk-virtual)
  283.    (outline :accessor outline    :init-keyword :outline :allocation :tk-virtual)
  284.    (start   :accessor start    :init-keyword :start   :allocation :tk-virtual)
  285.    (stipple :accessor stipple    :init-keyword :stipple :allocation :tk-virtual)
  286.    (style   :accessor style    :init-keyword :style   :allocation :tk-virtual)
  287.    (width   :accessor width    :init-keyword :width   :allocation :tk-virtual)))
  288.  
  289. (define-method canvas-item-initializer((self <Arc>))    "arc")
  290.  
  291.  
  292. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  293. ;;;;
  294. ;;;; <Bitmap-item> class definition
  295. ;;;;
  296. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  297. (define-class <Bitmap-item> (<Tk-canvas-figure>)
  298.   ((anchor      :accessor     anchor
  299.             :init-keyword     :anchor
  300.             :allocation     :tk-virtual)
  301.    (background  :accessor     background
  302.             :init-keyword     :background
  303.             :allocation     :tk-virtual)
  304.    (bitmap-name :accessor     bitmap-name
  305.             :init-keyword     :bitmap-name
  306.         :tk-name    bitmap
  307.             :allocation     :tk-virtual)
  308.    (foreground  :accessor     foreground
  309.             :init-keyword    :foreground
  310.             :allocation    :tk-virtual)))
  311.  
  312. (define-method canvas-item-initializer((self <Bitmap-Item>))    "bitmap")
  313.  
  314. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  315. ;;;;
  316. ;;;; <Image-item> class definition
  317. ;;;;
  318. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  319. (define-class <Image-item> (<Tk-canvas-figure>)
  320.   ((anchor     :accessor     anchor
  321.            :init-keyword     :anchor
  322.            :allocation     :tk-virtual)
  323.    (image-name :accessor    image-name
  324.            :init-keyword    :image-name
  325.            :tk-name        image
  326.            :allocation    :tk-virtual)))
  327.  
  328. (define-method canvas-item-initializer((self <Image-Item>))    "image")
  329.  
  330. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  331. ;;;;
  332. ;;;; <Line> class definition
  333. ;;;;
  334. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  335. (define-class <Line> (<Tk-canvas-figure>)
  336.   ((arrow     :accessor     arrow    
  337.          :init-keyword     :arrow 
  338.          :allocation     :tk-virtual)
  339.    (arrow-shape     :accessor     arrow-shape
  340.          :init-keyword     :arrow-shape 
  341.          :tk-name     arrowshape 
  342.          :allocation     :tk-virtual)
  343.    (cap-style     :accessor     cap-style
  344.          :init-keyword     :cap-style
  345.          :tk-name    capstyle
  346.          :allocation     :tk-virtual)
  347.    (fill     :accessor     fill
  348.          :init-keyword     :fill 
  349.          :tk-name     fill 
  350.          :allocation     :tk-virtual)
  351.    (join-style     :accessor     join-style
  352.          :init-keyword     :join-style 
  353.          :tk-name     joinstyle 
  354.          :allocation     :tk-virtual)
  355.    (smooth     :accessor     smooth
  356.          :init-keyword     :smooth 
  357.          :allocation     :tk-virtual)
  358.    (spline-steps :accessor     spline-steps
  359.          :init-keyword     :spline-steps 
  360.          :tk-name     splinesteps 
  361.          :allocation     :tk-virtual)
  362.    (stipple     :accessor     stipple
  363.          :init-keyword     :stipple 
  364.          :allocation     :tk-virtual)
  365.    (width     :accessor     width
  366.          :init-keyword     :width 
  367.          :allocation     :tk-virtual)))
  368.  
  369. (define-method canvas-item-initializer((self <Line>))        "line")
  370.  
  371.  
  372. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  373. ;;;;
  374. ;;;; <Oval> class definition
  375. ;;;;
  376. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  377. (define-class <Oval> (<Tk-canvas-figure>)
  378.   ((fill    :accessor fill    :init-keyword :fill    :allocation :tk-virtual)
  379.    (outline :accessor outline :init-keyword :outline :allocation :tk-virtual)
  380.    (stipple :accessor stipple :init-keyword :stipple :allocation :tk-virtual)
  381.    (width   :accessor width   :init-keyword :width   :allocation :tk-virtual)))
  382.  
  383. (define-method canvas-item-initializer((self <Oval>))        "oval")
  384.  
  385. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  386. ;;;;
  387. ;;;; <Polygon> class definition
  388. ;;;;
  389. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  390. (define-class <Polygon> (<Tk-canvas-figure>)
  391.   ((fill         :accessor     fill    
  392.          :init-keyword     :fill 
  393.          :allocation     :tk-virtual)
  394.    (outline      :accessor     outline    
  395.          :init-keyword  :outline 
  396.          :allocation    :tk-virtual)
  397.    (smooth       :accessor     smooth  
  398.          :init-keyword     :smooth
  399.          :allocation     :tk-virtual)
  400.    (spline-steps :accessor     spline-steps
  401.          :init-keyword     :spline-steps
  402.          :tk-name     splinesteps
  403.          :allocation     :tk-virtual)
  404.    (stipple      :accessor     stipple
  405.          :init-keyword     :stipple
  406.          :allocation     :tk-virtual)
  407.    (width        :accessor     width   
  408.          :init-keyword  :width
  409.          :allocation     :tk-virtual)))
  410.  
  411. (define-method canvas-item-initializer((self <Polygon>))    "polygon")
  412.  
  413.  
  414. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  415. ;;;;
  416. ;;;; <Rectangle> class definition
  417. ;;;;
  418. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  419. (define-class <Rectangle> (<Tk-canvas-figure>)
  420.   ((fill    :accessor fill    :init-keyword :fill    :allocation :tk-virtual)
  421.    (outline :accessor outline :init-keyword :outline :allocation :tk-virtual)
  422.    (stipple :accessor stipple :init-keyword :stipple :allocation :tk-virtual)
  423.    (width   :accessor width   :init-keyword :width   :allocation :tk-virtual)))
  424.  
  425. (define-method canvas-item-initializer((self <Rectangle>))    "rectangle")
  426.  
  427.  
  428. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  429. ;;;;
  430. ;;;; <Text-Item> class definition
  431. ;;;;
  432. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  433. (define-class <Text-item> (<Tk-canvas-figure>)
  434.   ((anchor  :accessor anchor  :init-keyword :anchor  :allocation :tk-virtual)
  435.    (fill    :accessor fill    :init-keyword :fill    :allocation :tk-virtual)
  436.    (font    :accessor font    :init-keyword :font    :allocation :tk-virtual)
  437.    (justify :accessor justify :init-keyword :justify :allocation :tk-virtual)
  438.    (stipple :accessor stipple :init-keyword :stipple :allocation :tk-virtual) 
  439.    (text    :accessor text-of :init-keyword :text    :allocation :tk-virtual)
  440.    (width   :accessor width   :init-keyword :width   :allocation :tk-virtual)))
  441.  
  442. (define-method canvas-item-initializer((self <Text-item>))    "text")
  443.  
  444. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  445. ;;;;
  446. ;;;; <Canvas-window> class definition
  447. ;;;;
  448. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  449. (define-class <Canvas-Window> (<Tk-canvas-figure>)
  450.   ((anchor  :accessor anchor  :init-keyword :anchor  :allocation :tk-virtual)
  451.    (height  :accessor height  :init-keyword :height  :allocation :tk-virtual)
  452.    (width   :accessor width   :init-keyword :width   :allocation :tk-virtual)
  453.    (window  :accessor window  :init-keyword :window  :allocation :tk-virtual)))
  454.  
  455. (define-method canvas-item-initializer((self <Canvas-window>))    "window")
  456.  
  457.  
  458. (provide "Canvitem")
  459.